home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / egg / egg-jisx0201.el.z / egg-jisx0201.el
Encoding:
Text File  |  1998-05-21  |  7.5 KB  |  286 lines
  1. ;; Utility for HankakuKana (jisx0201)
  2.  
  3. ;; This file is part of Egg on Mule (Japanese Environment)
  4.  
  5. ;; Egg is distributed in the forms of patches to GNU
  6. ;; Emacs under the terms of the GNU EMACS GENERAL PUBLIC
  7. ;; LICENSE which is distributed along with GNU Emacs by the
  8. ;; Free Software Foundation.
  9.  
  10. ;; Egg is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied
  12. ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  13. ;; PURPOSE.  See the GNU EMACS GENERAL PUBLIC LICENSE for
  14. ;; more details.
  15.  
  16. ;; You should have received a copy of the GNU EMACS GENERAL
  17. ;; PUBLIC LICENSE along with Nemacs; see the file COPYING.
  18. ;; If not, write to the Free Software Foundation, 675 Mass
  19. ;; Ave, Cambridge, MA 02139, USA.
  20.  
  21. ;;; 92.9.24  created for Mule Ver.0.9.6 by K.Shibata <shibata@sgi.co.jp>
  22. ;;; 93.8.3   modified for Mule Ver.1.1 by K.Handa <handa@etl.go.jp>
  23. ;;;    Not to define regexp of Japanese word in this file.
  24.  
  25. (require 'egg)
  26. (provide 'egg-jisx0201)
  27.  
  28. (defvar *katakana-alist*
  29.   '(( 161 . "(I'(B" )
  30.     ( 162 . "(I1(B" )
  31.     ( 163 . "(I((B" )
  32.     ( 164 . "(I2(B" )
  33.     ( 165 . "(I)(B" )
  34.     ( 166 . "(I3(B" )
  35.     ( 167 . "(I*(B" )
  36.     ( 168 . "(I4(B" )
  37.     ( 169 . "(I+(B" )
  38.     ( 170 . "(I5(B" )
  39.     ( 171 . "(I6(B" )
  40.     ( 172 . "(I6^(B" )
  41.     ( 173 . "(I7(B" )
  42.     ( 174 . "(I7^(B" )
  43.     ( 175 . "(I8(B" )
  44.     ( 176 . "(I8^(B" )
  45.     ( 177 . "(I9(B" )
  46.     ( 178 . "(I9^(B" )
  47.     ( 179 . "(I:(B" )
  48.     ( 180 . "(I:^(B" )
  49.     ( 181 . "(I;(B" )
  50.     ( 182 . "(I;^(B" )
  51.     ( 183 . "(I<(B" )
  52.     ( 184 . "(I<^(B" )
  53.     ( 185 . "(I=(B" )
  54.     ( 186 . "(I=^(B" )
  55.     ( 187 . "(I>(B" )
  56.     ( 188 . "(I>^(B" )
  57.     ( 189 . "(I?(B" )
  58.     ( 190 . "(I?^(B" )
  59.     ( 191 . "(I@(B" )
  60.     ( 192 . "(I@^(B" )
  61.     ( 193 . "(IA(B" )
  62.     ( 194 . "(IA^(B" )
  63.     ( 195 . "(I/(B" )
  64.     ( 196 . "(IB(B" )
  65.     ( 197 . "(IB^(B" )
  66.     ( 198 . "(IC(B" )
  67.     ( 199 . "(IC^(B" )
  68.     ( 200 . "(ID(B" )
  69.     ( 201 . "(ID^(B" )
  70.     ( 202 . "(IE(B" )
  71.     ( 203 . "(IF(B" )
  72.     ( 204 . "(IG(B" )
  73.     ( 205 . "(IH(B" )
  74.     ( 206 . "(II(B" )
  75.     ( 207 . "(IJ(B" )
  76.     ( 208 . "(IJ^(B" )
  77.     ( 209 . "(IJ_(B" )
  78.     ( 210 . "(IK(B" )
  79.     ( 211 . "(IK^(B" )
  80.     ( 212 . "(IK_(B" )
  81.     ( 213 . "(IL(B" )
  82.     ( 214 . "(IL^(B" )
  83.     ( 215 . "(IL_(B" )
  84.     ( 216 . "(IM(B" )
  85.     ( 217 . "(IM^(B" )
  86.     ( 218 . "(IM_(B" )
  87.     ( 219 . "(IN(B" )
  88.     ( 220 . "(IN^(B" )
  89.     ( 221 . "(IN_(B" )
  90.     ( 222 . "(IO(B" )
  91.     ( 223 . "(IP(B" )
  92.     ( 224 . "(IQ(B" )
  93.     ( 225 . "(IR(B" )
  94.     ( 226 . "(IS(B" )
  95.     ( 227 . "(I,(B" )
  96.     ( 228 . "(IT(B" )
  97.     ( 229 . "(I-(B" )
  98.     ( 230 . "(IU(B" )
  99.     ( 231 . "(I.(B" )
  100.     ( 232 . "(IV(B" )
  101.     ( 233 . "(IW(B" )
  102.     ( 234 . "(IX(B" )
  103.     ( 235 . "(IY(B" )
  104.     ( 236 . "(IZ(B" )
  105.     ( 237 . "(I[(B" )
  106.     ( 239 . "(I\(B" ) ; (I\(B -> $B%o(B $B$KJQ49$9$k$h$&$K(B
  107.     ( 238 . "(I\(B" ) ; $B%o$H%n$N=gHV$,8r49$7$F$"$k!#(B
  108.     ( 240 . "(I((B" )
  109.     ( 241 . "(I*(B" )
  110.     ( 242 . "(I&(B" )
  111.     ( 243 . "(I](B" )
  112.     ( 244 . "(I3^(B" )
  113.     ( 245 . "(I6(B" )
  114.     ( 246 . "(I9(B" )))
  115.  
  116. (defvar *katakana-kigou-alist*
  117.   '(( 162 . "(I$(B" )
  118.     ( 163 . "(I!(B" )
  119.     ( 166 . "(I%(B" )
  120.     ( 171 . "(I^(B" )
  121.     ( 172 . "(I_(B" )
  122.     ( 188 . "(I0(B" )
  123.     ( 214 . "(I"(B" )
  124.     ( 215 . "(I#(B" )))
  125.  
  126. (defvar *dakuon-list*
  127.   '( ?$B%+(B ?$B%-(B ?$B%/(B ?$B%1(B ?$B%3(B
  128.      ?$B%5(B ?$B%7(B ?$B%9(B ?$B%;(B ?$B%=(B
  129.      ?$B%?(B ?$B%A(B ?$B%D(B ?$B%F(B ?$B%H(B
  130.      ?$B%O(B ?$B%R(B ?$B%U(B ?$B%X(B ?$B%[(B))
  131.  
  132. (defvar *handakuon-list* (memq ?$B%O(B *dakuon-list*))
  133.  
  134. ;;;
  135. ;;; $BH>3QJQ49(B
  136. ;;; 
  137.  
  138. (defun hankaku-katakana-region (start end &optional arg)
  139.   (interactive "r\nP")
  140.   (save-restriction
  141.     (narrow-to-region start end)
  142.     (goto-char (point-min))
  143.     (let ((regexp (if arg "\\cS\\|\\cK\\|\\cH" "\\cS\\|\\cK")))
  144.       (while (re-search-forward regexp (point-max) (point-max))
  145.     (let* ((ch (char-to-int (char-before)))
  146.            (ch1 (/ ch 256))
  147.            (ch2 (mod ch 256)))
  148.       (cond ((= 208 ch1)
  149.          (let ((val (cdr (assq ch2 *katakana-kigou-alist*))))
  150.            (if val (progn
  151.                  (delete-char -1)
  152.                  (insert val)))))
  153.         ((or (= 209 ch1) (= 215 ch1))
  154.          nil)
  155.         (t
  156.          (let ((val (cdr (assq ch2 *katakana-alist*))))
  157.            (if val (progn
  158.                  (delete-char -1)
  159.                  (insert val)))))))))))
  160.  
  161. (defun hankaku-katakana-paragraph ()
  162.   "hankaku-katakana paragraph at or after point."
  163.   (interactive )
  164.   (save-excursion
  165.     (forward-paragraph)
  166.     (let ((end (point)))
  167.       (backward-paragraph)
  168.       (hankaku-katakana-region (point) end ))))
  169.  
  170. (defun hankaku-katakana-sentence ()
  171.   "hankaku-katanaka sentence at or after point."
  172.   (interactive )
  173.   (save-excursion
  174.     (forward-sentence)
  175.     (let ((end (point)))
  176.       (backward-sentence)
  177.       (hankaku-katakana-region (point) end ))))
  178.  
  179. (defun hankaku-katakana-word (arg)
  180.   (interactive "p")
  181.   (let ((start (point)))
  182.     (forward-word arg)
  183.     (hankaku-katakana-region start (point))))
  184.  
  185. ;;;
  186. ;;; $BA43QJQ49(B
  187. ;;;
  188. (defun search-henkan-alist (ch list)
  189.   (let ((ptr list)
  190.     (result nil))
  191.     (while ptr
  192.       (if (string= ch (cdr (car ptr)))
  193.       (progn
  194.         (setq result (car (car ptr)))
  195.         (setq ptr nil))
  196.     (setq ptr (cdr ptr))))
  197.     result))
  198.  
  199. (defun zenkaku-katakana-region (start end)
  200.   (interactive "r")
  201.   (save-restriction
  202.     (narrow-to-region start end)
  203.     (goto-char (point-min))
  204.     (while (re-search-forward "\\ck" (point-max) (point-max))
  205.       (let ((ch (preceding-char))
  206.         (wk nil))
  207.     (cond
  208.      ((= ch ?(I^(B)
  209.       (save-excursion
  210.         (backward-char 1)
  211.         (setq wk (preceding-char)))
  212.       (cond ((= wk ?$B%&(B)
  213.          (delete-char -2)
  214.          (insert "$B%t(B"))
  215.         ((setq wk (memq wk *dakuon-list*))
  216.          (delete-char -2)
  217.          (insert (1+ (car wk))))
  218.         (t
  219.          (delete-char -1)
  220.          (insert "$B!+(B"))))
  221.      ((= ch ?(I_(B)
  222.       (save-excursion
  223.         (backward-char 1)
  224.         (setq wk (preceding-char)))
  225.       (if (setq wk (memq wk *handakuon-list*))
  226.           (progn
  227.         (delete-char -2)
  228.         (insert (+ 2 (car wk))))
  229.         (progn
  230.           (delete-char -1)
  231.           (insert "$B!,(B"))))
  232.      ((setq wk (search-henkan-alist
  233.             (char-to-string ch) *katakana-alist*))
  234.       (progn
  235.         (delete-char -1)
  236.         (insert (make-char 'japanese-jisx0208 37 (- wk 128)))))
  237.      ((setq wk (search-henkan-alist
  238.             (char-to-string ch) *katakana-kigou-alist*))
  239.       (progn
  240.         (delete-char -1)
  241.         (insert (make-char 'japanese-jisx0208 33 (- wk 128))))))))))
  242.  
  243. (defun zenkaku-katakana-paragraph ()
  244.   "zenkaku-katakana paragraph at or after point."
  245.   (interactive )
  246.   (save-excursion
  247.     (forward-paragraph)
  248.     (let ((end (point)))
  249.       (backward-paragraph)
  250.       (zenkaku-katakana-region (point) end ))))
  251.  
  252. (defun zenkaku-katakana-sentence ()
  253.   "zenkaku-katakana sentence at or after point."
  254.   (interactive )
  255.   (save-excursion
  256.     (forward-sentence)
  257.     (let ((end (point)))
  258.       (backward-sentence)
  259.       (zenkaku-katakana-region (point) end ))))
  260.  
  261. (defun zenkaku-katakana-word (arg)
  262.   (interactive "p")
  263.   (let ((start (point)))
  264.     (forward-word arg)
  265.     (zenkaku-katakana-region start (point))))
  266.  
  267. ;;;
  268. ;;;  JISX 0201 fence mode
  269. ;;;
  270.  
  271. (defun fence-hankaku-katakana  ()
  272.   (interactive)
  273.   (hankaku-katakana-region egg:*region-start* egg:*region-end* t))
  274.  
  275. (defun fence-katakana  ()
  276.   (interactive)
  277.   (zenkaku-katakana-region egg:*region-start* egg:*region-end* )
  278.   (katakana-region egg:*region-start* egg:*region-end*))
  279.  
  280. (defun fence-hiragana  ()
  281.   (interactive)
  282.   (zenkaku-katakana-region egg:*region-start* egg:*region-end*)
  283.   (hiragana-region egg:*region-start* egg:*region-end*))
  284.  
  285. (define-key fence-mode-map "\ex"  'fence-hankaku-katakana)
  286.